home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
AMIGA
/
AMICUS
/
AMICUS11.ADF
/
AmigaBasicProgs
/
Switch.MSB
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1986-08-05
|
8KB
|
349 lines
'Swichbox for 512 Amiga
'set Preferences for 80 columns
Restart:
CLEAR: GOSUB Setup
Main:
FOR round= 1 TO 4
PUT (80,7+round *8), ball
PUT (515,7+round *8), ball
GOSUB Values
SAY TRANSLATE$(intro$(round))
Keepgoing:
who =1-who
GOSUB Taketurn
IF SC(1-who,round)=> points(round,0) THEN Nextround
GOTO Keepgoing
Nextround:
FOR j=0 TO 1: FOR k=5 TO 8
SC(j,k)= 0:NEXT:NEXT
FOR j=0 TO 1: FOR k=1 TO 4
gx=points(k,0): ac=SC(j,k)
SC(j,5)= SC(j,5) +ac
SC(j,6)= SC(j,6) -(ac=>gx)*gx
SC(j,7)= SC(j,7) +SC(j,k) -SC(1-j,k)
NEXT:NEXT
FOR j=0 TO 1: FOR k=6 TO 7
SC(j,k)= SC(j,k) +SC(j,5)
NEXT:NEXT
FOR j=0 TO 1: FOR k=5 TO 7
SC(j,8)= SC(j,8)+ SC(j,k)
NEXT:NEXT
FOR j=0 TO 1
FOR k=5 TO 8: y$= STR$(SC(j,k))
x=LEN(y$): tx=8+j*64-x: ty=4+k
LOCATE ty,tx-1:PRINT SPACE$(2)
LOCATE ty,tx: PRINT y$
NEXT:NEXT
NEXT round
GoHome:
LINE(240,70)-(362,100),2,bf
LOCATE 11,32:PRINT "Play again?"
text$= who$(ABS(SC(1,8)>SC(0,8)))
text$= text$ +" wins this game."
text$= text$ +"How about another?"
SAY TRANSLATE$(text$), voice%
FOR j= 0 TO 10: x$=INKEY$:NEXT
Again:
x$=INKEY$: IF x$="" THEN Again
SAY TRANSLATE$( "OK."), voice%
IF x$="y" OR x$="Y" THEN WINDOW CLOSE 2: GOTO Restart
SAY TRANSLATE$( "Bye-bye."), voice%
WINDOW CLOSE 2
END
Taketurn:
FOR j=0 TO nb: LB(j,0)=0: NEXT: nb=1
SAY TRANSLATE$( who$(who) + CHR$(46))
PUT(140,5),larrow: PUT(440,5),rarrow
FOR j=0 TO 9: x$=INKEY$:NEXT
Getkey:
a$=INKEY$: IF a$="-" THEN RETURN
IF a$= "+" THEN a$=STR$(INT(RND(1)*8+1))
a=VAL(a$): IF (a<1) OR (a>8) THEN Getkey
LB(0,0)=1
FOR j= 1TO 3: LB(0,j)=0: NEXT
LB(0,4)= a+3
Moreballs:
ex=1: FOR j=0TO nb
IF LB(j,0)THEN ex=0: GOSUB Moveone
NEXT: IF ex=0THEN Moreballs
x=0: FOR j=13 TO 7 STEP -3: FOR k=x TO 15-x
PUT (column(k),row(j) +1), blank, AND
NEXT: x=x+1: NEXT: RETURN
Moveone:
dy=LB(j,0): dx=LB(j,1): ly=LB(j,2)
ny=LB(j,3): nx=LB(j,4)
IF ny THEN
PUT (column(nx),row(ny+(ly*3)) +1), blank, AND
END IF
LB(j,3)=(ny+1) MOD 3
ON ny+1 GOTO Pos0,Pos1,Pos2
Pos0:
IF ly>4 THEN LB(j,0)=0: GOTO Score
vx=0: GOSUB Whichway
IF (sw(wx,wy,1)) AND (sw(wx,wy,0) =sd) THEN
vx=1-2*sd:LB(j,3)=ny+1:LB(j,4)=nx+vx
GOTO Putball
END IF
IF sw(wx,wy,0)=sd THEN
LB(j,0)=0
sw(wx,wy,1)=1: ny=ny+1
GOTO Putball
END IF
LB(j,3)=ny+1: GOTO Putball
Pos1:
LB(j,1)=0: LB(j,4)=nx+dx: GOTO Putball
Pos2:
LB(j,2)=ly +1: GOSUB Whichway
sw(wx,wy,0)= 1- sw(wx,wy,0)
IF sw(wx,wy,1) THEN
PUT(column(LB(j,4)+1-sd*2),row(ny+(ly*3))), blank, AND
LB(nb,0)=1:LB(nb,1)=0:LB(nb,2)=ly
LB(nb,3)=0:LB(nb,4)=nx+1-sd*2:nb=nb+1
sw(wx,wy,1)=0
END IF
sx= xpos(wx,wy): sy=ypos(wx,wy)
wp=sw(wx,wy,0)
Switch:
PUT (sx,sy), swblank, AND
ON wp+1 GOTO Left,Right
Left:
PUT (sx,sy), lswitch, OR: GOTO Bop
Right:
PUT(sx,sy),rswitch, OR
Bop:
SOUND 100,1,64,who
SOUND 250,1,64,3-who
RETURN
Putball:
SOUND INT(RND(1)*10)*(30*ly)+ 200,1,64,who
PUT(column(nx),row(ny+(ly*3)+1)), ball,OR
RETURN
Whichway:
wx=ly:wy=INT((nx+ly-4)/2):sd=(nx+ly) AND 1:RETURN
Score:
sf=points(round,nx+1):sg=SC(who,round)+sf
tx=8+63*who+(sg>9)+(sg>99)+(sg>999)
ty=2+round:a$=MID$(STR$(sg),2)
LOCATE ty,tx:PRINT a$
SC(who,round)=sg
FOR j=1600 TO 200 STEP-300
SOUND j,1,64,who
SOUND j+400,1,64,3-who
NEXT:RETURN
Values:
FOR j=0 TO 1
k=2+70*j: LOCATE 15,k
PRINT SPACE$(3): LOCATE 15,k
PRINT RIGHT$(STR$(points(round,0)),3)
NEXT
FOR j=1 TO 16:k=points(round,j)
m=6+j*3.75
IF k>9 THEN
x= INT(k/10)
x$= MID$(STR$(x),2,1)
ELSE
x$=CHR$(32)
END IF
LOCATE 22,m:PRINT x$;
LOCATE 23,m:PRINT RIGHT$(STR$(k),1);
NEXT:RETURN
Setup:
RANDOMIZE TIMER
DIM voice%(8)
FOR j=0TO 8
READ voice%(j):NEXT
DATA 110,0,150,0,22200,64,10,1,0
Greet$="Hi. Welcome to Switchbox."
PRINT Greet$
SAY TRANSLATE$(Greet$),voice%
SCREEN 2,640,200,2,2
PALETTE 0,0,0,0
PALETTE 1,1,1,1
PALETTE 2,0,0.1,0.7
PALETTE 3,1,1,0.13
WINDOW 2,"Switchbox",,0
DIM larrow(30),rarrow(30),wav%(256),lefthunk(400)
DIM righthunk(400),swblank(100),rswitch(200)
DIM lswitch(200),column(16),row(25)
DIM blank(70),ball(60),piece(80)
DIM sw(8,8,1),LB(32,4),points(4,16),SC(1,8)
FOR j=0 TO 10:LINE (0,5)-(10,j),3
NEXT
LINE (10,3)-(20,7),3,bf
GET(0,0)-(20,10), larrow
PUT(0,0),larrow
FOR j=1 TO 10
LINE (20,5)-(10,j),3
NEXT
LINE (0,3)-(10,7),3,bf
GET(0,0)-(20,10), rarrow
PUT(0,0),rarrow
GET(8,2)-(22,9),blank
CIRCLE(15,4),7,1
PAINT (16,4),1
GET(8,0)-(22,9),ball
PUT(8,0),ball
FOR j= 0 TO 127:wav%(j)= -127
wav%(j=128)=127: NEXT
FOR j=0 TO 3: WAVE j, wav%
NEXT
DATA 10,"round 1. equal scores."
DATA 2,2,2,2,2,2,2,2
DATA 40,"round 2. fibonachie sequence."
DATA 1,2,3,5,8,13,21,34
DATA 20,"round 3. arithmetic sequence."
DATA 2,3,4,5,6,7,8,9
DATA 80,"round 4. sequence of squares."
DATA 1,4,9,16,25,36,49,64
FOR j=1 TO 4: READ points(j,0)
READ intro$(j)
FOR k=1 TO 8:READ x
points(j,k+8)=x: points(j,9-k)=x
NEXT k: NEXT j
a=215: b=2
FOR j= 0TO 4
a=a-30: b=b+30
FOR k=0 TO j+3
xpos(j,k)= a+k*60
ypos(j,k)=b
NEXT:NEXT
k=0
FOR j=70 TO 520 STEP 30
column(k)=j
k=k+1:NEXT
k=0
FOR j=4 TO 154 STEP 10
row(k)=j: k=k+1:NEXT
Start:
SAY TRANSLATE$("First player's name?"),voice%
INPUT"Name of player 1";p0$
SAY TRANSLATE$("Second player's name?"),voice%
INPUT"Name of player 2";p1$
who$(0)=LEFT$(p0$,6):who$(1)=LEFT$(p1$,6)
text$= who$(0)+ " plays " + who$(1)+ ". Is this correct"
PRINT text$;
SAY TRANSLATE$(text$),voice%
INPUT query$: an$= LEFT$(query$,1)
IF LEN(an$)=0 OR an$="y" OR an$="Y" THEN Draw
GOTO Start
Draw:
SAY TRANSLATE$("Oh Kay."),voice%
CLS
LOCATE 1,6:PRINT who$(0)
LOCATE 1,66:PRINT who$(1)
x=4: FOR j=0 TO 1
LINE(x,12)-(x+110,60),2,bf
LINE(x+6,10)-(x+120,58),3,bf
LINE(x+16,14)-(x+110,48),0,bf
x=x+480:NEXT
x=1: FOR j=24 TO 50 STEP 3.7
LOCATE 2,j: PRINT x
x=x+1: NEXT
LINE(180,0)-(182,40),,bf
GET (180,0)-(182,40),piece
LINE(180,0)-(420,0)
FOR j=210 TO 420 STEP 60
LINE(j,0)-(j+2,12),,bf
PUT (j,40),piece
PUT (j,100),piece
NEXT
FOR j=180 TO 420 STEP 60
PUT (j,0),piece,OR
PUT (j,70),piece
PUT (j,126),piece
NEXT
PUT (120,126),piece
PUT (150,100),piece
PUT (450,100),piece
PUT (480,126),piece
ERASE piece
FOR j=30 TO 570 STEP 30
LINE(j,155)-(j+2,170),1,bf
NEXT
LINE(176,4)-(186,32),2,bf
LINE(416,4)-(426,32),2,bf
LINE(176,32)-(156,42),2
LINE STEP(0,0)-STEP(-10,0),2
LINE STEP(0,0)-STEP(35,-32),2
PAINT(175,31),2
LINE(426,32)-(446,42),2
LINE STEP(0,0)-STEP(10,0),2
LINE STEP(0,0)-STEP(-36,-32),2
PAINT(427,32),2
GET(136,12)-(186,69),lefthunk
GET(416,12)-(456,62),righthunk
l=106:r=446:k=42
FOR j=1TO 4
PUT(l,k),lefthunk,OR
PUT(r,k),righthunk,OR
l=l-30:r=r+30:k=k+30
NEXT
ERASE lefthunk,righthunk
LINE(26,153)-(36,165),2,bf
LINE(564,153)-(576,165),2,bf
GET(245,32)-(299,40),swblank
FOR j=0 TO 18
LINE(270+j,40)-(280+j,32),3
NEXT
LINE(245,39)-(280,40),3,bf
GET(245,32)-(298,40),rswitch
PUT(184,32),swblank,AND
FOR j=0 TO 20
LINE(184+j,32)-(193+j,40),3
NEXT
LINE(193,39)-(236,40),3,bf
GET(184,32)-(236,40),lswitch
FOR m=0 TO 4: FOR n=0TO m+3
sx=xpos(m,n): sy=ypos(m,n)
wp=INT(RND(1)*2)
sw(m,n,0)=wp
sw(m,n,1)=0
who=1-who: GOSUB Switch
NEXT n: NEXT m
PUT(140,5), larrow
RETURN